home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / QuickDrawPrinter.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-01-29  |  9.8 KB  |  218 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 29 Jan 96
  5. MODULE QuickDrawPrinter; (*mf 6.7.93 / mah 
  6.     IMPORT
  7.         SYSTEM, Sys, Macintosh, Display, Display1, Printer, Files, Texts, Fonts, Viewers, TextFrames, Oberon, Directories;
  8.     CONST
  9.         white=FALSE;
  10.         maxfonts=64;
  11.         fntScale=72;
  12.     TYPE
  13.         Poly=RECORD a, b, c, d, t: REAL END;
  14.         PolyVector=ARRAY 20 OF Poly;
  15.         FontDescr=RECORD
  16.             num, size, face: INTEGER;
  17.             map: Macintosh.FontMapPtr
  18.         END;
  19.         dpi: LONGINT; pageOpen: BOOLEAN;
  20.         printPort: Sys.GrafPtr; printHnd: Sys.TPrHnd; prStatus: Sys.TPrStatus;
  21.         nofonts: INTEGER; fontname: ARRAY maxfonts, 32 OF CHAR; font: ARRAY maxfonts OF Macintosh.FontMapPtr;
  22.         d: Directories.Directory;
  23.     PROCEDURE ^Open(VAR name, user: ARRAY OF CHAR; password: LONGINT);
  24.     PROCEDURE MapString(VAR fname: ARRAY OF CHAR; VAR s, ms: ARRAY OF CHAR);
  25.         VAR i, j: INTEGER; back: CHAR;
  26.     BEGIN i:=0; j:=0;
  27.         LOOP
  28.             CASE s[i] OF
  29.             | 0X: ms[j]:=0X; RETURN
  30.             | 9X: ms[j]:=" "; INC(j); ms[j]:=" "; INC(j); ms[j]:=" "; INC(j); ms[j]:=" "
  31.             | "_":
  32.                 back := fname[6]; fname[6] := 0X;
  33.                 IF (Macintosh.syntaxFnt # Macintosh.helveticFnt) & (fname = "Syntax") THEN ms[j]:="-" ELSE ms[j] := '_' END;
  34.                 fname[6] := back
  35.             | 80X: ms[j]:=80X (*Ae*)
  36.             | 81X: ms[j]:=85X (*Oe*)
  37.             | 82X: ms[j]:=86X (*Ue*)
  38.             | 83X: ms[j]:=8AX (*ae*)
  39.             | 84X: ms[j]:=9AX (*oe*)
  40.             | 85X: ms[j]:=9FX (*ue*)
  41.             ELSE ms[j]:=s[i]
  42.             END;
  43.             INC(i); INC(j)
  44.         END
  45.     END MapString;
  46.     PROCEDURE EnterFont(fontno: INTEGER; VAR fname: ARRAY OF CHAR);
  47.         VAR fntNum, fntSize, fntFace, i: INTEGER;
  48.     BEGIN Macintosh.GetFontInfo(fname, fntNum, fntSize, fntFace); fntSize:=SHORT(fntSize*dpi DIV fntScale);
  49.         IF fntNum=Macintosh.syntaxFnt THEN fntNum:=Macintosh.helveticFnt END;
  50.         font[fontno]:=Macintosh.NewFontMap(fntNum, fntSize, fntFace); 
  51. (*        IF printPort = 0 THEN printPort:=Sys.PrOpenDoc(printHnd, 0, 0) END; *)
  52.         IF printPort # 0 THEN Macintosh.SetPenPort(SYSTEM.VAL (Sys.GrafPtr, printPort))  END;
  53.     END EnterFont;
  54.     PROCEDURE SetDocTitle;
  55.         VAR str: Sys.Str255;
  56.     BEGIN Macintosh.SetStr255(str, "Oberon document");
  57.         Sys.SetWTitle(SYSTEM.VAL (Sys.GrafPtr, Macintosh.thePortPtr), str)
  58.     END SetDocTitle;
  59.     PROCEDURE GetDPI;
  60.         TYPE
  61.             XY=RECORD x, y: INTEGER END;
  62.             GetRsl=RECORD op, err: INTEGER; misc: ARRAY 7 OF INTEGER; cnt: INTEGER; res: ARRAY 27 OF XY END;
  63.             SetRsl=RECORD op, err: INTEGER; dum: LONGINT; hPrint: Sys.TPrHnd; x, y: INTEGER END;
  64.         VAR
  65.             res: XY; getRsl: GetRsl; setRsl: SetRsl; i: INTEGER;
  66.     BEGIN dpi:=0; getRsl.op:=4; Sys.PrGeneral(SYSTEM.ADR(getRsl));
  67.         IF (getRsl.err=0)&(Sys.PrError()=0) THEN i:=0;
  68.             WHILE i < getRsl.cnt DO res:=getRsl.res[i];
  69.                 IF (res.x=res.y)&(res.x > dpi) THEN dpi:=res.y END;
  70.                 INC(i)
  71.             END;
  72.             setRsl.hPrint:=printHnd; setRsl.x:=SHORT(dpi); setRsl.y:=SHORT(dpi); setRsl.op:=5; Sys.PrGeneral(SYSTEM.ADR(setRsl));
  73.             IF (setRsl.err#0)OR(Sys.PrError()#0) THEN dpi:=0 END
  74.         END
  75.     END GetDPI;
  76.     PROCEDURE * Open(VAR name, user: ARRAY OF CHAR; password: LONGINT);
  77.         VAR ph: Sys.TPrRealHnd; pp: Sys.TPrRealPtr;
  78.     BEGIN nofonts:=0; Printer.res:=1;
  79.         d := Directories.Current(); 
  80.         Sys.PrOpen;
  81.         IF Sys.PrError()=0 THEN SetDocTitle; Sys.PrintDefault(printHnd); GetDPI;
  82.             IF (dpi#0) & Sys.PrStlDialog(printHnd) & Sys.PrJobDialog(printHnd) THEN printPort:=Sys.PrOpenDoc(printHnd, 0, 0);
  83.                 IF Sys.PrError()=0 THEN pageOpen:=FALSE; Printer.res:=0;
  84.                     ph:=SYSTEM.VAL (Sys.TPrRealHnd, printHnd);
  85.                     pp:=SYSTEM.VAL (Sys.TPrRealPtr, ph.p);
  86.                     Printer.PageWidth:=SHORT(LONG(pp.right)*300 DIV dpi);
  87.                     Printer.PageHeight:=SHORT(LONG(pp.bottom)*300 DIV dpi)
  88.                 ELSE Sys.PrCloseDoc(printPort); Sys.PrClose END
  89.             ELSE Sys.PrClose END
  90.         ELSE Sys.PrClose END;
  91.         Directories.Change (d.path)
  92.     END Open;
  93.     PROCEDURE OpenPage;
  94.     BEGIN
  95.         IF printPort = 0 THEN printPort:=Sys.PrOpenDoc(printHnd, 0, 0) END; 
  96.         IF ~pageOpen THEN Sys.PrOpenPage(printPort, 0);
  97.             IF Sys.PrError()#0 THEN HALT(99) END;
  98.             Macintosh.SetPenPort(printPort); Sys.TextMode(1); Sys.PenMode(0); pageOpen:=TRUE
  99. (*            Macintosh.SetPenPort(printPort); Sys.TextMode(1); Sys.PenMode(9); pageOpen:=TRUE *)
  100.         END
  101.     END OpenPage;
  102.     PROCEDURE * Page(nofcopies: INTEGER);
  103.     BEGIN Sys.PrClosePage(printPort);
  104.         IF Sys.PrError()#0 THEN HALT(99) END;
  105.         pageOpen:=FALSE
  106.     END Page;
  107.     PROCEDURE * Close;
  108.         VAR ph: Sys.TPrRealHnd; pp: Sys.TPrRealPtr;
  109.     BEGIN
  110.         IF pageOpen THEN Page(0) END;
  111.         Sys.PrCloseDoc(printPort);
  112.         IF Sys.PrError()#0 THEN HALT(99) END;
  113.         ph:=SYSTEM.VAL (Sys.TPrRealHnd, printHnd);
  114.         pp:=SYSTEM.VAL (Sys.TPrRealPtr, ph.p);
  115.         IF pp.bjdl=1 THEN Sys.PrPicFile(printHnd, 0, 0, 0, prStatus) END;
  116.         Sys.PrClose; printPort := 0;
  117.         WHILE nofonts > 0 DO DEC(nofonts); fontname[nofonts, 0]:=" " END;
  118.         Directories.Change (d.path)
  119.     END Close;
  120.     PROCEDURE fontno(VAR name: ARRAY OF CHAR): INTEGER;
  121.         VAR i, j: INTEGER;
  122.     BEGIN i:=0;
  123.         WHILE (i < nofonts) & (fontname[i]#name) DO INC(i) END;
  124.         IF i=nofonts THEN
  125.             IF nofonts < maxfonts THEN COPY(name, fontname[i]); INC(nofonts); EnterFont(i, name) ELSE i:=0 END
  126.         END;
  127.         RETURN i
  128.     END fontno;
  129.     PROCEDURE * UseListFont(VAR name: ARRAY OF CHAR);
  130.         VAR i: INTEGER; listfont: ARRAY 32 OF CHAR;
  131.     BEGIN listfont:="Times9.Scn.Fnt"; i:=0;
  132.         WHILE (i < nofonts) & (fontname[i]#name) DO INC(i) END;
  133.         IF i=nofonts THEN COPY(name, fontname[i]); INC(nofonts); EnterFont(i, listfont) END;
  134.     END UseListFont;
  135.     PROCEDURE * ReplConst(x, y, w, h: INTEGER);
  136.     BEGIN OpenPage; Macintosh.ReplConst(
  137.         SHORT((x*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y)*dpi+150) DIV 300),
  138.         SHORT((w*dpi+150) DIV 300), SHORT((h*dpi+150) DIV 300))
  139.     END ReplConst;
  140.     PROCEDURE * ContString(VAR s, fname: ARRAY OF CHAR);
  141.         VAR ms: ARRAY 4096 OF CHAR;
  142.     BEGIN OpenPage; MapString(fname, s, ms); Macintosh.ContString(font[fontno(fname)], ms)
  143.     END ContString;
  144.     PROCEDURE * String(x, y: INTEGER; VAR s, fname: ARRAY OF CHAR);
  145.         VAR ms: ARRAY 4096 OF CHAR; fnt: Macintosh.FontMapRealPtr;
  146.     BEGIN OpenPage; fnt:=SYSTEM.VAL (Macintosh.FontMapRealPtr, font[fontno(fname)]); MapString(fname, s, ms);
  147.         Macintosh.String(font[fontno(fname)],
  148.         SHORT((x*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y-fnt.ndescent)*dpi+150) DIV 300), ms)
  149.     END String;
  150.     PROCEDURE * ReplPattern(x, y, w, h, col: INTEGER);
  151.     BEGIN OpenPage; Macintosh.ReplPattern(Display1.ThisPattern(col),
  152.         SHORT((x*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y)*dpi+150) DIV 300),
  153.         SHORT((w*dpi+150) DIV 300), SHORT((h*dpi+150) DIV 300))
  154.     END ReplPattern;
  155.     PROCEDURE * Picture(x, y, w, h, mode: INTEGER; adr: LONGINT);
  156.         VAR p: Sys.GrafPtr;
  157.     BEGIN p:=SYSTEM.VAL(Sys.GrafPtr, adr); OpenPage; Macintosh.CopyBlock(p, printPort, 0, h, w, h,
  158.         SHORT((x*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y)*dpi+150) DIV 300),
  159.         SHORT((w*dpi*2+75) DIV 150), SHORT((h*dpi*2+75) DIV 150));
  160.     END Picture;
  161.     PROCEDURE * Circle(x0, y0, r: INTEGER);
  162.     BEGIN OpenPage; Macintosh.Circle(
  163.         SHORT((x0*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y0)*dpi+150) DIV 300), SHORT((r*dpi+150) DIV 300))
  164.     END Circle;
  165.     PROCEDURE * Ellipse(x0, y0, a, b: INTEGER);
  166.     BEGIN OpenPage; Macintosh.Ellipse(
  167.         SHORT((x0*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y0)*dpi+150) DIV 300),
  168.         SHORT((a*dpi+150) DIV 300), SHORT((b*dpi+150) DIV 300))
  169.     END Ellipse;
  170.     PROCEDURE * Line(x0, y0, x1, y1: INTEGER);
  171.     BEGIN OpenPage; Macintosh.Line(
  172.         SHORT((x0*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y0)*dpi+150) DIV 300),
  173.         SHORT((x1*dpi+150) DIV 300), SHORT(((Printer.PageHeight-y1)*dpi+150) DIV 300))
  174.     END Line;
  175.     PROCEDURE PrintPoly(VAR p, q: Poly; lim: REAL);
  176.         VAR t: REAL;
  177.     BEGIN t:=0;
  178.         REPEAT Macintosh.Dot(
  179.             SHORT(ENTIER(((((p.a*t+p.b)*t+p.c)*t+p.d)*dpi/300)+0.5)),
  180.             SHORT(ENTIER((((Printer.PageHeight-1)-(((q.a*t+q.b)*t+q.c)*t+q.d))*dpi/300)+0.5)));
  181.             t:=t+1.0
  182.         UNTIL t >=lim
  183.     END PrintPoly;
  184.     PROCEDURE * Spline(x0, y0, n, open: INTEGER; VAR X, Y: ARRAY OF INTEGER);
  185.         VAR i: INTEGER; dx, dy, ds: REAL; x, xd, y, yd, s: Macintosh.RealVector; p, q: PolyVector;
  186.     BEGIN x[0]:=X[0]+x0; y[0]:=Y[0]+y0; s[0]:=0; i:=1;
  187.         WHILE i < n DO x[i]:=X[i]+x0; dx:=x[i]-x[i-1]; y[i]:=Y[i]+y0; dy:=y[i]-y[i-1]; s[i]:=ABS(dx)+ABS(dy)+s[i-1]; INC(i) END;
  188.         IF open=1 THEN Macintosh.OpenSpline(s, x, xd, n); Macintosh.OpenSpline(s, y, yd, n)
  189.         ELSE Macintosh.ClosedSpline(s, x, xd, n); Macintosh.ClosedSpline(s, y, yd, n) END;
  190.         i:=0;
  191.         WHILE i < n-1 DO ds:=1.0/(s[i+1]-s[i]); dx:=(x[i+1]-x[i])*ds; dy:=ds*(y[i+1]-y[i]);
  192.             p[i].a:=ds*ds*(xd[i]+xd[i+1]-2.0*dx); p[i].b:=ds*(3.0*dx-2.0*xd[i]-xd[i+1]); p[i].c:=xd[i]; p[i].d:=x[i]; p[i].t:=s[i];
  193.             q[i].a:=ds*ds*(yd[i]+yd[i+1]-2.0*dy); q[i].b:=ds*(3.0*dy-2.0*yd[i]-yd[i+1]); q[i].c:=yd[i]; q[i].d:=y[i]; q[i].t:=s[i]; INC(i)
  194.         END;
  195.         p[i].t:=s[i]; q[i].t:=s[i];
  196.         OpenPage; i:=0;
  197.         WHILE i < n-1 DO PrintPoly(p[i], q[i], p[i+1].t-p[i].t); INC(i) END
  198.     END Spline;
  199.     PROCEDURE * GetMetrics (VAR fname: ARRAY OF CHAR; VAR fdx: ARRAY OF SHORTINT; VAR found: BOOLEAN);
  200.         VAR fnt: Macintosh.FontMapRealPtr; i: INTEGER; back: CHAR;
  201.     BEGIN fnt:=SYSTEM.VAL (Macintosh.FontMapRealPtr, font[fontno(fname)]); found:=TRUE; i:=0;
  202.         WHILE i < 0FFH DO fdx[i]:=SHORT(SHORT((LONG(fnt.width[i])*600+dpi) DIV (2*dpi))); INC(i) END;
  203.         back := fname[6]; fname[6] := 0X;
  204.         IF (Macintosh.syntaxFnt # Macintosh.helveticFnt) & (fname = "Syntax") THEN fdx[ORD("_")]:=fdx[ORD("-")] END;
  205.         fname[6] := back;
  206.         fdx[81H]:=fdx[85H]; fdx[82H]:=fdx[86H]; fdx[83H]:=fdx[8AH]; fdx[84H]:=fdx[9AH]; fdx[85H]:=fdx[9FH]
  207.     END GetMetrics;
  208.     PROCEDURE Install*;
  209.     BEGIN Macintosh.prQD:=TRUE;
  210.         Macintosh.prOpen:=Open; Macintosh.prClose:=Close; Macintosh.prPage:=Page;
  211.         Macintosh.prCircle:=Circle; Macintosh.prEllipse:=Ellipse; Macintosh.prLine:=Line; Macintosh.prSpline:=Spline;
  212.         Macintosh.prPicture:=Picture; Macintosh.prReplConst:=ReplConst; Macintosh.prReplPattern:=ReplPattern;
  213.         Macintosh.prString:=String; Macintosh.prContString:=ContString; Macintosh.prUseListFont:=UseListFont;
  214.         Macintosh.prGetMetrics:=GetMetrics
  215.     END Install;
  216. BEGIN  printHnd:=Sys.NewHandle (120); Sys.PrOpen; Sys.PrintDefault(printHnd); GetDPI; Sys.PrClose
  217. END QuickDrawPrinter.
  218.